home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hobby PC 28
/
Hobby PC 28.iso
/
MicrografxMM
/
FlowCharter
/
Autosamp
/
EXCELDAT.FRM
< prev
next >
Wrap
Text File
|
1997-03-04
|
12KB
|
410 lines
VERSION 4.00
Begin VB.Form ExcelSample
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Excel Data DEMO"
ClientHeight = 4125
ClientLeft = 3480
ClientTop = 1800
ClientWidth = 4815
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 4815
Icon = "EXCELDAT.frx":0000
Left = 3420
LinkTopic = "Form1"
ScaleHeight = 4125
ScaleWidth = 4815
Top = 1170
Width = 4935
Begin VB.CommandButton ReadData
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Read Data"
Height = 375
Left = 3360
TabIndex = 8
Top = 3120
Width = 1215
End
Begin VB.ListBox ExcelFields
Appearance = 0 'Flat
Height = 1590
Left = 360
MultiSelect = 2 'Extended
TabIndex = 3
TabStop = 0 'False
Top = 1560
Width = 2655
End
Begin VB.CommandButton Browse
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Browse..."
Height = 375
Left = 3240
TabIndex = 2
Top = 600
Width = 1215
End
Begin VB.CommandButton Quit
Appearance = 0 'Flat
BackColor = &H80000005&
Cancel = -1 'True
Caption = "&Quit"
Height = 375
Left = 3360
TabIndex = 1
Top = 1320
Width = 1215
End
Begin VB.CommandButton MakeChart
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Make &Chart"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 3360
TabIndex = 0
Top = 3600
Width = 1215
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Source Excel Data File"
ForeColor = &H80000008&
Height = 975
Left = 240
TabIndex = 4
Top = 120
Width = 4335
Begin VB.TextBox DataFilename
Appearance = 0 'Flat
Height = 300
Left = 120
TabIndex = 5
Text = "DataFilename"
Top = 510
Width = 2715
End
End
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Fields"
ForeColor = &H80000008&
Height = 2775
Left = 240
TabIndex = 6
Top = 1200
Width = 2895
Begin VB.Label HintText
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "To multi-select, click on items in the list while holding the CTRL key."
ForeColor = &H80000008&
Height = 615
Left = 120
TabIndex = 7
Top = 2040
Width = 2655
End
End
Begin MSComDlg.CommonDialog CMDialog1
Left = 3720
Top = 2160
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin VB.Menu Help
Caption = "Help"
Begin VB.Menu About
Caption = "About"
End
End
End
Attribute VB_Name = "ExcelSample"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Const xlR1C1 = -4150
Dim TraderData(40, 15) As String
Dim Record_Count As Integer
Dim CreateFailed As Integer
Dim Col As Integer, Row As Integer
Dim ExcelApp As Object
Private Sub About_Click()
Load AboutForm
AboutForm.Visible = True
ExcelSample.Enabled = False
End Sub
Private Sub Browse_Click()
On Error GoTo ErrHandler2 'CancelError is True
'Set filters
CMDialog1.Filter = "Excel Files (*.xls)|*.XLS|Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
CMDialog1.FilterIndex = 1 'Set default filter
CMDialog1.Action = 1 'Display the Open dialog box
DataFilename = CMDialog1.filename
ErrHandler2: 'User pressed Cancel button
Exit Sub
End Sub
Private Sub CreateExcel()
On Error GoTo ExcelFail
CreateFailed = False
Set ExcelApp = CreateObject("Excel.Application")
Exit Sub
ExcelFail:
Call HourGlassOff
MsgBox "You must have MS Excel installed to run this DEMO!", 16, "Critical Error"
CreateFailed = True
Resume Next
End Sub
Private Sub DataFilename_Change()
Call ValidateFilename
End Sub
Private Sub Form_Load()
DataFilename = App.Path + "\ABCSAMPL.XLS"
End Sub
Private Sub GetDataFile(DataFile As String)
Dim ExcelSheet As Object, xlWorkbooks As Object
Dim Cell As Object
Dim Rowz As Integer, Colz As Integer
' Load up Excel - sets ExcelApp Object
Call CreateExcel
If CreateFailed Then Exit Sub
ExcelApp.Application.Visible = True
Set xlWorkbooks = ExcelApp.Workbooks
xlWorkbooks.Open DataFile
Set ExcelSheet = ExcelApp.ActiveSheet
ExcelSheet.Activate
ExcelApp.ReferenceStyle = xlR1C1
ExcelSample.Visible = False
' Find the first row with data
' (check only the first 256 rows)
For FirstRow = 1 To 256
Set Cell = ExcelSheet.Cells(FirstRow, 1)
Cell.Select
If Not Cell.Value = Empty Then Exit For
Next FirstRow
' Find the last row with data
' (check only the first 256 rows)
For Rows = FirstRow To FirstRow + 256
Set Cell = ExcelSheet.Cells(Rows, 1)
Cell.Select
If Cell.Value = Empty Then
Rows = Rows - FirstRow - 1
Exit For
End If
Next Rows
' Now count the number of columns
' (Again only up to 256)
For Col = 1 To 256
Set Cell = ExcelSheet.Cells(FirstRow, Col)
Cell.Select
If Cell.Value = Empty Then
Col = Col - 1
Exit For
End If
Next Col
DoEvents
Call HourGlassOn
For Rowz = 1 To Rows + 1
For Colz = 1 To Col
Set Cell = ExcelSheet.Cells(FirstRow + Rowz - 1, Colz)
Cell.Select
TraderData(Rowz, Colz) = Cell.Value
Next Colz
Next Rowz
Call HourGlassOff
Record_Count = Rows
For Colz = 1 To Col
ExcelFields.AddItem TraderData(1, Colz)
Next Colz
ExcelSheet.Application.DisplayAlerts = False
ExcelSheet.Application.ActiveWorkbook.Close
ExcelApp.Application.Quit
ExcelSample.Visible = True
MakeChart.Enabled = True
Call SelectAll(ExcelFields)
End Sub
Private Sub GetExcel()
On Error GoTo TryCreate
Call HourGlassOn
Set ExcelApp = GetObject(, "Excel.Application")
Call HourGlassOff
Exit Sub
TryCreate:
Call CreateExcel
Resume Next
End Sub
Private Sub HourGlassOff()
Screen.MousePointer = 0
End Sub
Private Sub HourGlassOn()
Screen.MousePointer = 11
End Sub
Private Sub MakeChart_Click()
Dim A